home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / blt1.000 / blt1 / blt-1.7-for-STk / dd-protocol.stklos < prev    next >
Encoding:
Text File  |  1994-07-26  |  4.3 KB  |  120 lines
  1. ;;;; ----------------------------------------------------------------------
  2. ;;;;  PURPOSE:  drag&drop send routine for "XXX" data
  3. ;;;;
  4. ;;;;  Widgets that are to participate in drag&drop operations for
  5. ;;;;  "XXX" data should be registered as follows:
  6. ;;;;
  7. ;;;;      (blt_drag&drop .win 'source 'handler 'XXX 'dd-send-color)
  8. ;;;;      (blt_drag&drop .win 'target 'handler 'XXX 'my-color-handler)
  9. ;;;;
  10. ;;;;      (define (my-color-handler)
  11. ;;;;          (let ((data (hash-table-get DragDrop 'XXX ;;;;f)))
  12. ;;;;        (if data
  13. ;;;;           .
  14. ;;;;                   .  do something with $data
  15. ;;;;                  .
  16. ;;;;                )))
  17. ;;;; ORIGINAL AUTHOR:  Michael J. McLennan       Phone: (215)770-2842
  18. ;;;;                    AT&T Bell Laboratories   E-mail: aluxpo!mmc@att.com
  19. ;;;;
  20. ;;;; ----------------------------------------------------------------------
  21. ;;;;            Copyright (c) 1993  AT&T  All Rights Reserved
  22. ;;;; ======================================================================
  23.  
  24. ;;;;
  25. ;;;; rewritten for STk by Erick Gallesio [eg@unice.fr]
  26. ;;;;    Creation date:  7-Jul-1994 10:13
  27. ;;;; Last file update: 13-Jul-1994 16:46
  28.  
  29. (require "hash")
  30. (require "stklos")
  31.  
  32. (define DragDrop (make-hash-table))
  33.  
  34. (define (make-drag&drop-label win . args)
  35.   (let* ((token-name (& win ".label")))
  36.     ;; If this window already exists, don't create it
  37.     (when (= (winfo 'exists token-name) 0)
  38.       (pack (label token-name)))
  39.     ;; Now configure it to the given arguments
  40.     (apply (string->widget token-name) 'configure args)))
  41.  
  42. (define (drag&drop . l)
  43.   (apply blt_drag&drop (map (lambda(x) (if (instance? x) (slot-ref x 'Id) x)) l)))
  44.  
  45. (define (drag&drop-configure win . args)
  46.   (let ((pc   (get-keyword :package-command args #f))
  47.     (sh   (get-keyword :source-handler  args #f))
  48.     (th   (get-keyword :target-handler  args #f)))
  49.     (when pc (drag&drop 'source win 'config :package pc))
  50.     (when sh (apply drag&drop 'source win 'handler sh))
  51.     (when th (apply drag&drop 'target win 'handler th))))
  52.  
  53. ;;;; ----------------------------------------------------------------------
  54. ;;;; (dd-send-color <interp> <ddwin> <data>)
  55. ;;;;
  56. ;;;;   INPUTS
  57. ;;;;     <interp> = interpreter for target application
  58. ;;;;      <ddwin> = pathname for target drag&drop window
  59. ;;;;       <data> = data returned from -tokencmd
  60. ;;;;
  61. ;;;;   RETURNS
  62. ;;;;     ""
  63. ;;;;
  64. ;;;;   SIDE-EFFECTS
  65. ;;;;     Sends data to remote application DragDrop(color), and then
  66. ;;;;     invokes the "color" handler for the drag&drop target.
  67. ;;;; ----------------------------------------------------------------------
  68. (define (dd-send-color interp ddwin data)
  69.   (send interp `(begin
  70.           ;; Verify it is a color
  71.           (winfo 'rgb *root* ',data)
  72.           (hash-table-put! DragDrop 'color ',data)))
  73.   (send interp `(blt_drag&drop 'target ,ddwin 'handle 'color))
  74.   "")
  75.  
  76. ;;;; ----------------------------------------------------------------------
  77. ;;;; dd-send-number <interp> <ddwin> <data>
  78. ;;;;
  79. ;;;;   INPUTS
  80. ;;;;     <interp> = interpreter for target application
  81. ;;;;      <ddwin> = pathname for target drag&drop window
  82. ;;;;       <data> = data returned from -tokencmd
  83. ;;;;
  84. ;;;;   RETURNS
  85. ;;;;     ""
  86. ;;;;
  87. ;;;;   SIDE-EFFECTS
  88. ;;;;     Sends data to remote application DragDrop(number), and then
  89. ;;;;     invokes the "number" handler for the drag&drop target.
  90. ;;;; ----------------------------------------------------------------------
  91. (define (dd-send-number interp ddwin data)
  92.   (send interp `(let ((x (if (string? ,data) (string->number ,data) ,data)))
  93.           (unless (number? x)
  94.               (error "dd-send-number: nbad number: ~S." x))
  95.           (hash-table-put! DragDrop 'number x)))
  96.   (send interp `(blt_drag&drop 'target ,ddwin 'handle 'number))
  97.   "")
  98.  
  99. ;;;; ----------------------------------------------------------------------
  100. ;;;; (dd-send-text <interp> <ddwin> <data>)
  101. ;;;;
  102. ;;;;   INPUTS
  103. ;;;;     <interp> = interpreter for target application
  104. ;;;;      <ddwin> = pathname for target drag&drop window
  105. ;;;;       <data> = data returned from -tokencmd
  106. ;;;;
  107. ;;;;   RETURNS
  108. ;;;;     ""
  109. ;;;;
  110. ;;;;   SIDE-EFFECTS
  111. ;;;;     Sends data to remote application DragDrop(text), and then
  112. ;;;;     invokes the "text" handler for the drag&drop target.
  113. ;;;; ----------------------------------------------------------------------
  114. (define (dd-send-text interp ddwin data)
  115.   (send interp `(hash-table-put! DragDrop 'text ,data))
  116.   (send interp `(blt_drag&drop 'target ,ddwin 'handle 'text))
  117.   "")
  118.  
  119. (provide "dd-protocol.stklos")
  120.